VERSION 1.0 CLASS
BEGIN
  MultiUse = 0   'False
END
Attribute VB_Name = "clscContacts"
Attribute VB_Creatable = True
Attribute VB_Exposed = True

Option Explicit

Private colData As New Collection
'Requred property (or function)
Public Property Get Item(Index) As clsContact
Set Item = colData(Index)
End Property

'Requred property (or function)
Public Property Get Count()
Count = colData.Count
End Property

Public Sub Add(NewItem As clsContact)
colData.Add NewItem
End Sub
Public Sub Create(Optional Parent)

Dim rs As Recordset
Dim qd As QueryDef
Dim qdChildren As QueryDef
Dim rsChilren As Recordset
Dim i As Integer
Dim ctItem As clsContact
On Error Resume Next

If IsMissing(Parent) Then 'Top level
    
    Set rs = dbMain.OpenRecordset("ContactTypes")
    
    rs.MoveFirst
    
    For i = 1 To rs.RecordCount
        Set ctItem = New clsContact
        With ctItem
            .Name = rs!ContactType & ""
            .Image = "Folder"
            .HasChildren = rs!HasChildren
        End With
        colData.Add ctItem
        rs.MoveNext
    Next i
    
    rs.Close
    
  Else
    
    Select Case Parent.Image
    
        Case "Folder" 'Folder
            
            Set qd = dbMain.QueryDefs("CompaniesByContactType")
            qd.Parameters(0) = Parent.Name
            Set rs = qd.OpenRecordset()
            rs.MoveLast
            If Err = 3021 Then Exit Sub 'No current record
            rs.MoveFirst
            
            For i = 1 To rs.RecordCount
                Set ctItem = New clsContact
                With ctItem
                    .Name = rs!CompanyName & ""
                    .HasChildren = True
                    .Image = "Company"
                End With
                colData.Add ctItem
                rs.MoveNext
            Next i
            
            rs.Close
        
        Case "Company" 'Company
        
            Set qd = dbMain.QueryDefs("ContactsByCompany")
            qd.Parameters(0) = Parent.Name
            Set rs = qd.OpenRecordset()
            rs.MoveLast
            rs.MoveFirst
            
            For i = 1 To rs.RecordCount
                Set ctItem = New clsContact
                With ctItem
                    .Name = rs!Name & ""
                    .WorkPhone = rs!WorkPhone & ""
                    .LastMeetingDate = rs!LastMeetingDate
                    .Image = "Contact"
                End With
                colData.Add ctItem
                rs.MoveNext
            Next i
            rs.Close
    End Select

End If

End Sub

Private Sub Class_Initialize()
If dbMain Is Nothing Then Set dbMain = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\Sample")
End Sub
